Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/fopen/fopen.frm

Text File | 1995-05-08 | 13KB | 470 lines

VERSION 2.00
Begin Form FOpenForm
   BorderStyle     =   3  'Fixed Double
   Caption         =   "File Open"
   ClientHeight    =   3150
   ClientLeft      =   3000
   ClientTop       =   2460
   ClientWidth     =   4980
   Height          =   3555
   Icon            =   FOPEN.FRX:0000
   Left            =   2940
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3150
   ScaleWidth      =   4980
   Top             =   2115
   Width           =   5100
   Begin ListBox List1
      Height          =   1785
      Left            =   1965
      TabIndex        =   1
      Top             =   1170
      Width           =   1575
   End
   Begin FileListBox File1
      Height          =   1785
      Left            =   165
      TabIndex        =   3
      Top             =   1170
      Width           =   1575
   End
   Begin CommandButton Command2
      Caption         =   "&Cancel"
      Height          =   375
      Left            =   3705
      TabIndex        =   7
      Top             =   615
      Width           =   1095
   End
   Begin CommandButton Command1
      Caption         =   "&Open"
      Default         =   -1  'True
      Height          =   375
      Left            =   3705
      TabIndex        =   6
      Top             =   135
      Width           =   1095
   End
   Begin TextBox Text1
      Height          =   315
      Left            =   1140
      TabIndex        =   5
      Text            =   "FileName"
      Top             =   165
      Width           =   2400
   End
   Begin Label DirLabel
      Caption         =   "&Directories:"
      Height          =   195
      Left            =   1970
      TabIndex        =   0
      Top             =   900
      Width           =   1035
   End
   Begin Label FilesLabel
      AutoSize        =   -1  'True
      Caption         =   "&Files:"
      Height          =   195
      Left            =   170
      TabIndex        =   2
      Top             =   915
      Width           =   465
   End
   Begin Label Label1
      Caption         =   "Label1"
      Height          =   255
      Left            =   1155
      TabIndex        =   9
      Top             =   580
      Width           =   2310
   End
   Begin Label Label4
      Caption         =   "Directory:"
      Height          =   255
      Left            =   170
      TabIndex        =   8
      Top             =   580
      Width           =   855
   End
   Begin Label FNameLabel
      Caption         =   "File &Name:"
      Height          =   255
      Left            =   170
      TabIndex        =   4
      Top             =   210
      Width           =   975
   End
End
'You are welcome to use FOPEN in your programs free of charge.
'If you make any improvements send me a copy at CIS-MAL 73667,1755
'Costas Kitsos
DefInt A-Z
Dim TheFocus%                   ' Handle for Drive/Subdirectory ListBox
Dim List1Flag%                  ' Flag for Drive/Subdirectory ListBox 0 or 1
Dim Text1Flag%                  ' Flag for EM_LIMITTEXT
Dim TheDrive$                   ' The selected drive
Dim LastChange As Integer       ' Flag used when processing selections

Function BuildSpec (fpath As String) As String
 ' builds the spec for SendMessage
    If Right$(fpath, 1) <> "\" Then
    s$ = fpath + "\*.*"
    Else
    s$ = fpath + "*.*"
    End If
    BuildSpec = s$
    s$ = ""
End Function

Sub ChangeDir (b$)
' change to the new directory and update List1
 List1.SetFocus
 TheFocus% = GetFocus()
 If InStr(b$, ":") Then b$ = Right$(b$, Len(b$) - 2)
 If Left$(b$, 1) <> "\" Then b$ = "\" + b$
 On Error Resume Next
   File1.Path = TheDrive$ + b$
   Label1.caption = File1.Path
   y& = SendMessage(TheFocus%, LB_RESETCONTENT, 0, ByVal "")
   x& = SendMessage(TheFocus%, LB_DIR, &HC010, ByVal BuildSpec((File1.Path)))
 If Err Then
 ' you may add a MsgBox error message here if you think it's
 ' necessary.
 End If
End Sub

Sub ChangeDrive (a$, ErrState%)
    OldPath$ = File1.Path
    List1.SetFocus
    TheFocus% = GetFocus()
 ' try to change to the new drive
    On Error Resume Next
        File1.Path = a$ + ":"
        y& = SendMessage(TheFocus%, LB_RESETCONTENT, 0, ByVal "")
        s$ = a$ + ":*.*"
        x& = SendMessage(TheFocus%, LB_DIR, &HC010, ByVal s$)
        Label1.caption = File1.Path
        TheDrive$ = a$ + ":"
        ErrState% = False
 ' if an error occurred go back to the way things were
    If Err Then
        MsgBox (Error$ + Chr$(13) + Chr$(10) + TheDrive$), 16, FormTitle
        TheDrive$ = Left$(OldPath$, 2)
        File1.Path = OldPath$
        If Right$(File1.Path, 1) <> "\" Then
        s$ = File1.Path + "\*.*"
        Else
        s$ = File1.Path + "*.*"
        End If
        y& = SendMessage(TheFocus%, LB_RESETCONTENT, 0, ByVal "")
        x& = SendMessage(TheFocus%, LB_DIR, &HC010, ByVal s$)
        Label1.caption = File1.Path
        Text1.Text = ThePattern
        ErrState% = True    'change the flag so Text1 knows
    End If
End Sub

Sub Command1_Click ()
    Select Case LastChange
      Case 1  'process Text1 entry
        Text1_KeyPress (13)

    Case 2  'we have a file, put together the FullName
        ThePath = File1.Path
        TheFileName = File1.FileName
        FullName = Left$(BuildSpec((File1.Path)), Len(BuildSpec((File1.Path))) - 3) + File1.FileName
        FOpenForm.Hide

    Case 3  'let List1 know
        List1_Dblclick

    Case 4  'we have a file and a FullName
        FOpenForm.Hide

    Case 5  'we have a file, put together the FullName
        ThePath = File1.Path
        FullName = Left$(BuildSpec((File1.Path)), Len(BuildSpec((File1.Path))) - 3) + TheFileName
        FOpenForm.Hide
    Case Else
    End Select
End Sub

Sub Command2_Click ()
 ' did the user press cancel?  Change FullName into an empty string
 ' so the Parent knows.
    FullName = ""
    FOpenForm.Hide
End Sub

Sub File1_Click ()
' update the textbox and the lastchange flag
  Text1.Text = File1.FileName
  LastChange = 2
End Sub

Sub File1_DblClick ()
' Good, we have a file, let's tell Command1
    LastChange = 2
    Command1_Click
End Sub

Sub File1_KeyPress (KeyAscii As Integer)
' if Return, select File1_DblClick
    If KeyAscii = 13 Then
    If File1.Listindex > -1 Then File1_DblClick
    End If
End Sub

Sub Form_GotFocus ()
    If List1Flag% = 0 Then
    List1.SetFocus          ' Set the Focus on List1 to fill the ListBox
    End If
End Sub

Sub Form_Load ()
 ' Set the flags for List1 and Text1
    List1Flag% = 0  ' Update Drive/Subdirectory listbox
    Text1Flag% = 0  ' Limit text length
 ' If the Parent didn't specify a FormTitle use the one that's built in.
    If FormTitle = "" Then
    FOpenForm.caption = "File Open"
    FormTitle = FOpenForm.caption
 ' otherwise honor the Parent's specification
    Else
    FOpenForm.caption = FormTitle
    End If

 ' If there is a path specification use it, otherwise use the default.
    If ThePath <> "" Then
    If Right$(ThePath, 1) = "\" Then
        ThePath = Left$(ThePath, (Len(ThePath) - 1))
        If Right$(ThePath, 1) = ":" Then ThePath = ThePath + "\"
    End If
    File1.Path = ThePath
    End If
    If ThePath = "" Then ThePath = File1.Path

 ' If the Parent specified a new pattern then use it.
    If ThePattern <> "" Then
    File1.Pattern = ThePattern
    End If

 ' Finish up loading the form.
    Text1.Text = File1.Pattern
    TheDrive$ = Left$(File1.Path, 2)
    Label1.caption = File1.Path
End Sub

Sub List1_Click ()
 ' let Command1 know
    LastChange = 3
End Sub

Sub List1_Dblclick ()
' List1 holds both drives and subdirectories
 If List1.Listindex > -1 Then
    curnt$ = List1.List(List1.Listindex)        'get the current selection
    OldPath$ = File1.Path                       'save the old path in case of error

 ' if the user chose a drive parse it and change to it
    If Left$(curnt$, 2) = "[-" And Len(curnt$) = 5 Then
    If Right$(curnt$, 2) = "-]" Then
        a$ = Mid$(curnt$, 3, 1)
        ChangeDrive a$, ErrState%
    End If